PPPPPPPPPPPP 
PPPPPPPPPPPP 
PPPPPPPPPPPP 
P PP 


P PPP 
PPPPPPPPPPPP 
PPPPPPPPPPPP 
PPPPPPPPPPPP 


GG 
GGGGGGGGG 


GGGGGGGGGGGG 
GGGGGGGGGGGG 


GGGGGGGGGGGG 
GG 


GGGGGGGGG 
GGGGGGGGG 


Att tt St st Ht Ht SH Ht tS St HH St 
| LLL) 
AHHH St tt St St tS St tS tS 


LLLLLLLLLLLLLLL 
LLLLLLLLLLLLLLL 
LLLLLLLLLLLLLLL 


o 


Va 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
09 
00 
00 


**F ILE**1D**RPGPRINT 


LLLLLLLLLL 
LLLLLLLLLL 


i amend 
— 
bbe 
se 


Pe ae fot Bs be ee Bt Be ae bo Be a 
tema feet ft be bet as nt fe be a bg Bt oe 


| eel aeeel 
bs be 
| eae 
ae 


a4 
44 
“a4 
“44 


ee | 
ee ee SL) 


* 
o 
7 
oO 
© 
e 
o 
oe 
e 
. 
e 
. 
2 
. 
a 
. 
. 
o 
2 
° 
. 
e 
. 
e 
e 
© 
e 
e 
e 
o 
° 
a 
a 
. 
co 
e 
. 
e 
. 
e 
- 
e 
. 
o 
* 
e 
a 
a 
o 
eo 
. 
e 
. 
o 
. 
oO 
. 
e 
© 
e 
o 
e 
. 
oe 
. 
a 
. 
e 
> 
a 
. 
e 
. 
e 
o 
e 
o 
e 
. 
e 
. 
e 
. 
e 
+ 
e 
. 
e 


+ AX-11 Oi lege 3e V4.0-74 Page 1 
224 RPGRTIL.SRCJRPGPRINT.B32;1 (1) 
le 
PR 


RPGSPRINT Support output to RPS PRINTER files 16- 
t s 
I 


NT.B32 EDIT:LPT1003 
BEGIN 


Vee RRR EEE EEE EERE EEE 


'® COPYRIGHT (c) 1978, 1980, 1982, 1984 BY 
is DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS. 
:* ALL RIGHTS RESERVED. 


® 

® 

* 

* 

® 

is THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED * 
iw ONLY IN ACCORDANCE WITH THE TERMS OF H LICENSE AND WITH THE * 
ie INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER * 
is COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY * 
iw OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY * 
is TRANSFERRED. ' 
we 

i® THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE * 
iw AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT * 
i CORPORATION. ® 
® 

* 

*® 

* 

* 

® 


!® DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR _ RELIABILITY OF ITS 
!® SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. 


it 
LR ERE EEE ERE REE ERE REE 
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ABSTRACT: 


This module contains the RTL routines to handle output to RPG 
PRINTER files for VAX-11 RPGII. 


ENVIRONMENT: VAX/VMS user mode 
AUTHOR: Debess Grabazs, CREATION DATE: 20-December-1982 
MODIFIED BY: 


1-001 = Original version. DG 20-DEC-82 ; ; 
1-002 - Added code review comments - most Becete cpr chenes is the different 
ingprag teceateuts for first page forms positioning. DG 26-MAY-83 
1-003 - 1. Add swoport for overprinting Lines. DJB 27-Jun-1983 F 
2. Only turn on overflow indicator if space or skip after is passed 
the overflow Line. LPT 5-Jul-1983 
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ort output to RPG PRINTER files 
arations 


RSBTTL ‘Declarations’ 

| PROLOGUE FILE: 

REQUIRE ‘'RTLIN:RPGPROLOG'; 
‘+ 

' LINKAGES 

: NONE 


14 


TABLE OF CONTENTS: 

FORWARD ROUTINE 
RPGS$PRINT, 

RPGS$TERM_PRINT; 


‘4 
' INCLUDE FILES 
: NONE 


nu 
Co 
8 
oO 
* 
co 


1+ 
! EQUATED SYMBOLS 
; NONE 

'¢ 


: EXTERNAL REFERENCES 


EXTERNAL ROUTINE 
LIBSGET_COMMAND, 
STRSUPCASE; 


EXTERNAL LITERAL 
RPG$_EXTINDOFF; 


“1984 02:18:04 — YAX=11 Bliss-32 
1984 8:00:26 ERPGRTL SRE SRPG 


ches, PSECTs, macros, 
kages and LIBRARYs 


aoe 


' Record header block fields 


' Get Line from SYSSCOMMAND 
! Convert string to uppercase 


! File not open error 


| 
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RPGSPRINT output to RPG PRINTER files 16-Sep-1984 18:04 AX=1 
1-003 T > busoert output to RPG PRINTER files 12-Sep-19 4 06: 48:9% 


ZSBTTL ‘RPGSPRINT - Support output to RPG PRINTER files’ 
GLOBAL ROUTINE RPGSPRINT( 
oe: REF $RAB_DECL ! RAB of file to be printed 


BS 


1 Bliss-32 V4.0-74 Pp 3 
ABGRTL SRE IRPEPMINY 203551 ne (3) 


vo 
27 


FUNCTIONAL DESCRIPTION: 


This routine supports output to RPG PRINTER files. It is called by 
the compiled code once for each write to @ PRINTER file. 


The main function of this routine is to fill in the two-byte 
fixed-length control area which is associated with each record 
and to write the print record to the file. This control area 
contains the apg oe controls for a print record. If spacing 
and skipping are both specified for the same line, they are 
performed in the following sequence: 

o Skip before 

o Space before 

o Print the Line 

o Skip after 
o Space after. , 
The ppcondery function of this routine is to detect page 
overflow. This occurs only the first time one of the following 
conditions occurs on the current page: ; 

o A Line is printed on the overflow Line 
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i 

' 

} 

} 

} 

: o A Line is printed past the overflow Line . 

: o The overflow Line is passed during a space operation 
‘ o The overflow Line is passed during a skip operation 
: (to a Line on the current page). 

: A special funtion of this routine is to allow ‘first page’’ 

: forms positioning. If both RPGSV_CTX_1PFORMS and RPGSV_CTX_FIRST 
! are set on, this routine will do the following: 

: PuT the record 

; If RMS returns a failure status, return 

’ Issue a message to SYSSCOMMAND to ask the user whether 
: forms are postioned correctly 

: accept continue’ or “‘retry'’ as a response 

‘ If the user responds with ‘retry’, go back to step 1 
! If the user responds with ‘continue’, clear 
RPGSV_CTX_FIRST and return. 
} 

i] 

i 

i 


CALLING SEQUENCE: 
return_status.wlc.v = RPGSPRINT (rab.rr.r) 
FORMAL PARAMETERS: 


rab address of the RAB of the file to be 
printed. 
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! IMPLICIT INPUTS: 


The implicit imputs for this procedure are contained in the file 
context block. This block is located at a negative offset to the 
They are defined in RPGDEF.REQ: 
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RPG$W_CTX_SPACEB number of Lines to space before printing. 
RPGS$W_CTX_SPACEA number of Lines to space after printing. 
RPGSW_CTX_SKIPB Line number to skip to before printing. 
RPGSW_CTX_SKIPA Line number to skip to after printing. 
RPGSV_CTX_FIRST TRUE before first write to the file to ensur 


e 
that values get initialized and that the ‘'first 
page’’ forms poets tag ing takes place, i 
requested, on the firs 


RPGS$V_CTX_1PFORMS TRUE when ‘first page’’ forms positioning has 
been requested. 


RPG$W_CTX_PFLAGS flags for print control: 
write. 


RPGS$V_CTX_OVLINE TRUE when this is an overflow Line. 

RPG$SW_CTX_LINE specifies the Line number at which the device is 
positioned within the current page body. 

RPGSW_CTX_FL specifies the number of Lines in the page body; 
i.e., it specifies the number of Lines on the 
logical page that can be written. 

RPGS$W_CTX_OL specifies the Line number of overflow Line. 

RPG$SA_CTX_OVIND specifies the address of the overflow indicator 
for this file. 

RABS$L_RHB is the address of the two byte control area 


to contain the print file information. The 
first byte is the ‘'prefix’’ area, and the second 
byte is the ‘‘postfix’’ area, specifying the 
number of Lines to advance before and after the 
record. respectively. 


IMPLICIT OUTPUTS: 
| 
| 
| 
| 
| 
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NONE 
ROUTINE VALUE: 

RMS status returned by the PUT operation or RPGS_EXTINDOFF. 
SIDE EFFECTS: 

A PUT to the Linage file is performed. 
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1-003 RPESPRINT > tapeort output to RPG PRINTER files 19286871 382 98: 0b i52 RPGRIL SRE IRPGPRING 64551 . (4) | 
H 17 4: BEGIN | H 
; 218 7 3 
: 219 0 LITERAL F 
; 0 1 SET_ON = 1 ! Context bit is set on if it equals one : 
> 221 Oo8¢ SET-OFF = 6 i Context bit is set off if it equals zero 3 
3 ¢ 028 SET“OFF_OVERFLOW = %X'FFFEFEFE', ! Overflow indicator is set off if the low bit ; 
2 0284 ! in the byte pointed to by RPGSA_CTX_OVIND and | ; 
3 : : 8 82 } ee low by in each of the following two bytes ; 
; ! is cleare 3 
; 226 0287 SET_ON_OVERFLOW = %X'00010101'; ! Overflow indicator is set on if the low bit : 
3 ger 0288 ! in the byte pointed to by RPG$A_CTX_OVIND and ; 
; § 8 0289 ! the low bit in each of the fot tSytng two bytes ; 
3 , : ey ! is set (note this mask is the NOT of SET_OFF_OVERFLOW) : 
3 231 0 35 CAL $ 
a « ¢ 029 ADV_LINES, ! Number of Lines to advance : 
3 23 osze LINE_FLAG: WORD, ! Flag to ensure print page ; 
; 234 0295 ! overflow occurs only once 3 
3 6¢s0 134) ! per page 3 
; 236 029 RET_STATUS, ' Return status 3 
s esr 0298 RHB-: REF BLOCKC,BYTE); ' Record header block 3 
: 238 94 3 
: 239 0300 BIND ; 
; 240 0301 FCB = RAB : REF BLOCK C,BYTE); ! File context block ; 
: 241 8206 2 3 
3 seg 0305 2 BUILTIN 3 
; 24 0304 § TESTBITSC; : 
: 244 0305 3 
> 245 0306 2 : i : 
; 246 0307 2 ! RPGSPRINT should not cause access violations. Since RPGS$PRINT is called : 
: 247 0308 2 ! before the associated SPUT, the RAB may be invalid. Validate the RAB : 
; sie ts4 2 by checking that RAB$W_ISI is non-zero. : 
5; eo 0311 IF .RABCRAB$SW_ISIJ EQ. 0 : 
s 2) O3i¢ THEN : 
; 33¢ 031 RETURN RPGS_EXTINDOFF; : 
. ze 0314 2 3 
: 254 0315 2 ! ; 
s @29 0316 2 ! Initialization 3 
: 256 0317 § : 3 
s €or 0318 LINE_FLAG = .FCBCRPGSW_CTX_LINE); ! Set overflow flag : 
; 258 0319 RHB = .RABCRABSL_ ; ' Point to control area : 
3 @eF 0320 RHBCPREFIX] = 0; ' Clear control area 3 
; 360 0$ 1 RHBCPOSTFIX) = 0; ; 
: 261 ; : 
; 6¢ Bs 4 ; : 
3 o7 b35¢ Process skipping and spacing before the print | : 
> 265 03 6 if .FCBCRPG$W_CTX_SKIPB] GTR 0 : 
3 $ B3 THEN 
3 4 3 8 BEGIN ! Skip before | 
: 369 9 i SKIP BEFORE indicated 
: 271 § ADV_LINES = .FCBCRPGSW_CTX_SKIPB] - .FCBCRPGS$SW_CTX_LINE); ' Number of Lines to advance | 
: 0 IF TADV_LINES NEG 0 i Make sure SKIP TO Line | 
: 4 ! is not current Line 

} 


a 
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RPGSPRINT Support output to RPG PRINTER files bese -1984 02:18:04 AX-11 Bliss-32 V4.0-74 P | 
1-003 RPESPRINY - Support output to RPG PRINTER files et yey RPGRTL.SRCIRPGPRINT .B3 31 sone «as 
: 274 7 THEN 
: Ne 2 BEGIN ! New Line | 
: 2? 4 FCBCRPGSW_CTX_LINE) = .FCBCRPGSW_CTX_SKIPB); t i | 
> 27 9 : 4 IF .ADV_LINES LSS 0 ; AS npn st Soap 
or 40 4 N | 
: s 8 *) 5 BEGIN 
; 8 “8 ; SKIP BEFORE will cause advance to a new page | 
: 284 0345 5 RHBCPREFIX] = .FCBCRPGSW_CTX_FL] + .ADV_LINES; ' Set prefix in control area 
; 285 8 m4 2 LINE FLAG = 0; ! flag reset for new page | 
; 266 4 FCBLRPG$V_CTX_OVPEND] = ei OFF; ! 1-003 Flag reset for new page 
; 87 0348 2 IF .FCBCRPG$VCTX_OVLINE) NEQ SET_ON 
: 289 0350 5 .FCBCRPGSA_CTX_OVIND] = ..FCBCRPGSA_CTX_OVIND] AND SET_OFF_OVERFLOW; 
: 331 0382 2 ! Set off the overflow indicator 
: 29 0353 5 END 
go tee ea 
; 236 b328 ? SKIP TO Line will be on the same page 
: 297 0358 4 RHBCPREFIX] = .ADV_LINES: ! Set prefix in control area 
; 4 SF : ! Set on the overflow indicator 
; $00 Bae) ; END; ! New Line | 
: 302 036s 2 END; ! Skip before | 
: 304 0365 g IF .FCBCRPGSW_CTX_SPACEB] GTR 0 
3 $0 0366 THEN 
So Ria 
3 308 0369 3 i SPACE BEFORE indicated 
; 30 0371 3 FCBCRPGSW_CTX_LINE) = .FCBCRPGSW_CTX_LINE) + .FCBCRPG$W_CTX_SPACEB); 
3; 31 bg ! Update current Line 
: 318 ti RHBCPREFIX] = .RHBCPREFIX] + .FCBCRPGS$W_CTX_SPACEB]; ! Adjust prefix in control area 
: 314 0375 END ! 1-003 | 
: 315 0376 ELSE ' 1-003 
: 16 0377 : ' 1-003 
s 317 O38 ! If the skip caused no advance, then we are going to print on ! 1-08 
: 318 37 ' the same Line as the previous PUT, so we need the specify CR ! 1-00 
3 1} bane in the prefix area to get overprinting. 1-08 
: 321 0382 if .RHBCPREFIX) EQL 0 i 1-00 | 
: : 0 8 THEN : 1-00 | 
; 384 RHBCPREFIX] = 2xX‘8D'; ' 1-003 
on Bee 
: 36 i Check for Line being printed on or past the overflow Line 
; 25 0 89 if -FCBCRPGSW_CTX_LINE] GEQ .FCBCRPGSW_CTX_OL) 
: $6 $391 IF (.LINE_FLAG LSS .RABCRPG$W_CTX_OLJ) OR ! First time on this page? 


H 3 
RPGSPRINT Support output to RPG PRINTER files 16-Sep-1984 02:18:04 AX-11 Bliss-32 V4.0-74 Page 7) 
808 RPGSPRINT > hupeort cutput to RPG PRINTER files aoe 96: 58:9% RPGRTL.SRCJRPGPRINT.B32;1 . (4) | 1-1 
: ; 3 —_ (. FCBCRPGSV_CTX_OVPEND] EQL SET_ON) ! 1-003 Was an overflow pending? : 
: 94 BEGIN ; 
; 95 : 
: 335 0 %6 -FCBCRPGSA_CTX_OVIND] = ..FCBCRPGSA_CTX_OVIND] OR SET_ON_OVERFLOW; ; 
3 6 9 ! Yes, set on the overflow indicator | ; 
; 9 98 FCBCRPG$V_CTX_OVPEND] = SET_OFF; i 1-063 | : 
: 339 0400 END; ; 
; 340 0401 : 
> 341 prs ' H 
: i} Be? Check for current Line being on new page : 
: a4 0405 iF <FCBCRPGSW_CTX LINE] GTR .FCBCRPGSW_CTX_FLJ 3 
: 346 0409 FCBCRPGSW_CTX_LINE] = .FCBCRPGSW_CTX_LINE] - .FCBCRPGSW_CTX_FLJ;! Adjust current Line to reflect ; 
; see Bee ! new page : 
: 349 0410 ; 
3 29 gett Process skipping and spacing after the print : 
; 3 $618 if .FCBCRPG$W_CTX_SKIPA] GTR 0 ; 
: 5 0414 § THE : 
: 354 0415 BEGIN ! Skip after 3 
3 Soe 0416 3 ! 3 
3 $29 gele ; : SKIP AFTER indicated : 
: 358 0419 ADV_LINES = .FCBCRPGSW_CTX_SKIPA] - .FCBLRPGSW_CTX_LINE); ! Number of Lines to advance ; 
; SoP 0420 3 IF .ADV_LINES NEQ 0 ! Make sure SKIP TO Line : 
: 300 Bes) ; on ! is not current Line : 
; 36¢ ee 4 BEGIN ! New Line ; 
; $07 b¢5¢ : cpocnnese CTE Lise} = .FCBCRPGSW_CTX_SKIPA]; ! Update current Line : 
: 365 0426 4 THEN ~ ; 
; 366 0427 5 BEGIN 3 
; 307 0428 5 ' 3 
; v4 be 3 2 SKIP AFTER will cause advance to a new page : 
; 370 Bee : RHBLPOSTF 1X] = .FCBCRPGSW_CTX_FL] + .ADV_LINES; at pogrrts ia control area : 
$ = 0; ! Rese ag for new page 3 
: r 0433 3 IF, FCBCRPGSV_CTX_OVLINE] NEQ SET_ON ° A | ; 
: 374 0435 5 .FCBLRPGSA_CTX_OVIND] = ..FCBCRPGSA_CTX_OVIND] AND SET_OFF_OVERFLOW; | ; 
: Le ty 2 ' Set off the overflow indicator : 
. | Py 
3 7 0438 5 END 3 
; 378 439 4 ELSE : 
3 79 440 4 ‘ : 
: 44 re ? } SKIP AFTER Line will be on the same page | : 
; 82 0443 4 RHBCPOSTFIX] = .ADV_LINES; ! Set postfix in control area | ; 
: 384 445 END; ! New Line | ; 
; 385 44 é 
; 386 44 END; ! Skip after 3 
: 387 0448 | 
| 
| 
j 


UE = 1, 
MIN_RESP_LEN = SCHARCOUNT ¢ "een? 
Minimum acceptable Length of 
i response to LIBSGET_COMMAND 


eee 
eens 
r _ 


} 
3 | 
RPGSPRINT Support output to RPG PRINTER files 1}. Se 4 2 & 4 AX-11 Bliss-32 V4.0-74 Page §8| 
1-003 RPEEPRINT = bneort output to RPG PRINTER files 14- ~300 71382 96:48 4 APGRTL SREIRPGPAE NT.B B35.1 . (4) | 
; 388 449 IF_.FCBCRPGSW_CTX_SPACEA] GTR 0 
; 389 4 THEN | 
: rs re 1 BEGIN 
; % 438 ; SPACE AFTER indicated | 
: 39% bc88 FCBCRPGS$W_CTX_LINE] = .FCBCRPG$W_CTX_LINE] + .FCBCRPGSW_CTX_SPACEA]; 
; 395 0456 ! Update current Line 
: Be peat RHBCPOSTFIX] = .RHBCPOSTFIX] + .FCBCRPGSW_CTX_SPACEA); : Adjust postfix in control area 
: 398 0459 END; 
; 399 bees 
; 400 461 : 
; ret Br0¢ Check for overflow Line being passed by space or skip 
: 40 0464 if (. beg te CTX_LINEJ GTR oF COCREGSY. CTX_OLJ) AND ' 1-003 OL passed during skip? 
: rer pee? (.LINE_FLAG LSS .FCBCRPG$W_CTX_OLJ)~ ! First time on this page? 
; 0467 FCBERPGSA_CTX_OVIND) = ..FCBCRPGSA_CTX_OVIND] OR SET_ON_OVERFLOW 
; 407 0468 ' Yes, set on the overflow indicator 
> 408 0469 LSE i 1-063 
; 409 0470 IF (.FCBCRPGSW_CTX_LINEJ EQL “PCOCRP GSU. CTX_OLJ) AND ' 1-003 OL reached durin space, ors 
3 re eg eget NE_FLAG LSS” .FCBCRPG$W_CTX_OLJ) e's First time on this page? 
: 412 0473 é FCBCRPG$V_CTX_OVPEND] = SET_ON; i 1-003 Flag that overflow is pendin 
5 414 0475 3 
; 415 0476 ! Check for current Line being on a new page 
: 416 0477 2 : 
3 ht Bere 2 IF .FCBCRPGSW_CTX_LINE] GTR .FCBCRPG$W_CTX_FLJ 
: 419 0480 : FCBCRPG$W_CTX_LINE] = .FCBCRPG$W_CTX_LINEJ - .FCBCRPG$W_CTX_FLJ;! Adjust current Line to reflect 
: re 0481 2 ! new page 
: 421 048 § 
$ rt 048 ! 
s $2 0484 2 ' It is qecessery to special-case the first WRITE on the first logical 
: 426 0485 ! page after a file has been OPENed so that ‘first page’ forms 
5 rH Bees positioning can be done. 
: 427 0488 if TESTBITSC(FCBCRPGSV_CTX_FIRST]) 
: 4628 0489 H 
: 429 490 IF .FCBCRPGSV_CTX_1PFORMS) 
: 43 493 THEN BEGIN ! First i itioni 
3 ' First page forms positionin 
o32 rf pag p g 
; 43 0494 L 
; 434 0495 GET_STATUS ' Return status from LIBSGET_COMMAND 
: 435 049 PROMPT DESC: BLOCKC8,BYTE), i pocal descriptor for prompt 
; 436 49 RESP_DESC: BLOCK(8, BYTE) i Local descriptor for response 
: 45 RESPBUF: VECTORL10,BYTEI; i Buffer for response 
; 139 LITERAL 
; 440 


TN ——_—_ 
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RPGSPRINT Support output to RPG PRINTER files 1b-se -1984 02:18:04 AX-11 Bliss-32 V4.0-74 Page 9 
1-003 RPGBPRING > huppert output to RPG PRINTER files 10-Sep-19 4 96: bbe AMGRTL SRE IRPGPRING 103551 ° (4) 
> 4465 LABEL 
; 44 30 OUTER_LOOP; 
; 44 3 
> 448 50 BIND 
3; 449 B29 ' 
; 450 8 11 ! NOTE = PROMPT must come directly before RET for the prompt 
3 $23 B2i§ } string length to be calculated correctly 
: re 0514 PROMPT = UPLIT (‘ Is forms positioning correct? Yes, type CONTINUE, No, type RETRY: '), 
: 454 0515 RET = UPLIT (‘RET’), 
3; 455 218 CON = UPLIT (‘*CON'); 
: $28 2} 
; #45 16 ' 
: +28 b238 } ‘First page’ forms positioning indicated 
: 460 0521 PROMPT _DESCCDSCSW_LENGTH] = CHSDIFF (RET, PROMPT); 
> 461 05 ¢ PROMPT_DESC 4431 MSDE = DSCS$K_CLASS_S; 
3 re 4 05 PROMPT _DESCLDSCSB_DTYPE] = DSCS$K_DTYPE_T; 
: 46 0524 PROMPT DESCCDSCSA_POINTER] = PROMPT; 
> 464 0525 RESP_DESCCDSCS$W_LENGTH] = ZALLOCATION (RESP_BUF); 
; 465 0526 RESP_DESC 4431 MS GEES = DSCS$K_CLASS_S; 
; 466 bast RESP_DESCCDSCSB_DTYPE] = DSCS$K_DTYPE_T; 
: 467 0528 RESP_DESCCDSCSA_POINTER] = RESP_BUF; 
; 468 B2¢2 
; 469 0530 4 OUTER_LOOP: BEGIN 
; 470 b2¢) 4 
: «471 05 ¢ 4 WHILE TRUE DO 
: 47 0533 5$ BEGIN ! Retry loop 
3; 47 0534 5§ ! 
3 474 0535 5 ! PUT the record 
3; 475 bees 5 } 
: 476 0537 5 RET_STATUS = $PUT(RAB = .RAB); ! Put out the record 
s 677 0538 6 IF NOT (.RET_STATUS) 
: 478 0539 5 THEN 
; 479 0540 6 BEGIN 
: 480 0541 6 ! 
; 481 0246 6 ! Error on PUT, return 
; 48 0543 6 } 
; 48 0544 6 FCBCRPG$V_CTX_FIRST] = SET_ON; ' Reset FIRST bit 
> 484 0545 6 RETURN .RET_STATUS; 
: 485 0546 6 
; 486 0547 5 END; 
3: 487 0548 ! 
; 488 Beep ! Issue a message to SYSSCOMMAND to ask the user 
; 489 550 ! whether forms are positioned correctly. 
; 490 0551 ! If response is neither RET(RY) or CON(TINUE), 
: 491 $236 ! promat again, 
: rts 327 f response is RETRY, go thru outer loop again. 
7 494 555 WHILE TRUE DO 
; «4495 228 6 BEGIN 
3; 4% 557 6 
; 497 558 6 DO ! Prompt for response until user types 
: rhe 222 ° ' RETCRY) or CON(TINUE) 
; 500 561 6 GET_STATUS = LIBSGET_COMMAND(RESP_DESC, PROMPT_DESC) 
; 501 562 6 UNTIL .GET_STATUS; 

! 
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RPGSPRINT Support output to RPG PRINTER files 16-Sep-1984 02:18:04 AX-11 Bliss-32 V4.0-74 
1-003 RPGSPRINI > luspert output to RPG PRINTER files 127808713 4 0g: 4B: 4 RPGRTL.SRC aPePRiny .03 31 ete (a3 
: 50 563 6 STRSUPCASE (RESP_DESC, RESP_DESC); : 
; 08 264 6 If CHSEQL (MIN_RESP_LEN, RESP_BUF. MIN_RESP_LEN, CON) ; 
: 505 366 £ LEAVE OUTER_LOOP; : 
; oF 36/ IF ck EQL (MIN_RESP_LEN, RESP_BUF, MIN_RESP_LEN, RET) ; 
: 508 569 EXITLOOP; : 
; 209 0870 F 
: 3i% 0873 a 
5 S12 0378 : END; ! Retry loop ; 
: Ae 0575 END; ! Quter Loop : 
: 312 p28 RETURN .RET_STATUS; ! Return status from PUT : 
318 0379 | END; ! First page forms positioning 
; 526 bee) ; When not special-casing, will get here. 3 
: 529 ba8e RETURN $PUT(RAB = .RAB); ! PUT out the record and : 
yy. 0584 ! return the RMS status 3 
> 524 0585 2 : 
: 525 0586 1 END; ; 
.TITLE RPGSPRINT Support output to RPG PRINTER files : 
TIDENT \1-003\ : 
.PSECT _RPGSCODE,NOWRT, SHR, PIC,2 
74 69 73 6F 70 20 73 6D 72 6F 66 20 73 49 20 00000 P.AAA: .ASCII \ Is f itioni t? Yes, type\ ; : 
SF 9 68 65 72 90 oF bk 88 Gr ce om Ok GF ay poooe Ce ee ee er ee ee : 
20 2¢ 6F GE 20 Sc Go $e Ge fo Sh Ge Se 2s 50 bone ASCII \ CONTINUE, No. type RETRY: \<0> 
Oo 36 SA 89 $3 8 C8 $3 3G GE $0 fo $2 Boose a : : 
00 54 45 52 00044 P.AAB: ASCII \RET\<O> : : 
00 4E& 4F 43 00048 P.AAC: <ASCII \CON\<0> : ; 
PROMPT= P.AAA ; 
RET= P-AAB : 
CON= P. AAC 
.EXTRN LIBSGET_ COMMAND 
-EXTRN STRSUPCASE, RPGS$_EXTINDOFF 
EXTRN SYS$PUT 
OOFC 00000 .ENTRY RPGSPRINT, Save R2,R3,R4,R5,R6,R7 > 0169 
57 000000006 00 9 000¢ MOV SySSPUT. R7 ; 
SE ic C 00 SUBL2 #28, SP ; 
54 06 AC D 0 MOVL RAB. R4& > 0311 
02 Aa B ot TSTW ¢(Rd) ; 
08 12 0001 BNEQ : 
50 000000006 8F i 0 15 MOVL #RPGS_EXTINDOFF, RO > 0313 
50 EE AG 001D 1$ MOVAB -18(R4), RO > 0318 
> 60 BO 00 4 MOVW (RO), LINE FLAG : 
1 2c =A4 «DO 00024 MOVL 44(R4), RHB : 0319 
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RPGSPRINT Support output to RPG PRINTER files 18-Sep-1984 09:18 9% Ax-11 Oi rege vi On 28s Page 11 RP( 
1-003 RPGSPRINT = Support output to RPG PRINTER files 14-Sep-1984 13:04:24 RPGRTL.SRCJRPGPRINT .B32;1 (4) 1-( 
61 B4 8 CLRW = (RHB) : 0320 
53 EA AG Re A HOVZWL =22(R4), R3 ; 9330 
5 " : MOVZWL (RO), ADV_LINES + 0332 
52 f 0 SUBL3 ADV_LINES> R3, ADV_LINES : 
4 0 BEQL «863 : 0333 
60 3 B 0 9 MOVW = R3, (RO) + 0338 
D C TSTL  ADV_LINES + 0339 
1A 18 000 : BGEQ ©. 2$ ; 
61 F2 AG 2¢ 81 0004 ADDB3 ADV_LINES, -14(R4), (RHB) : 0345 
55 «B4 00 43 CLRW  LINE_FLAG + 0346 
EC AG 08 A 0 4 BICB2 ag. =20(R4) : 0347 
0D EC AG £0 00048 BBS #2. -20(R4), 3$ + 0348 
F4 B4 00010101 BF ch 9090 BICL2 #6579 » a-12(R4) ; 0330 
61 93 90 OO05A 38: MOVB  ADV_LINES, (RHB) + 0358 
& AG B 9905p $: TSTW = = 26 TR4) + 0365 
OA 1 9060 BEQL ; 
60 E6 A& AD 0006 ADDW “6 (RA), > 0371 
61 E6 AS 80 00066 ADDB2 <-26(R4). (RHB) + 0373 
08 11 9006A BRB + 0365 
61 95 0006C 4$ TSTB = (RHB) : 0382 
04 12 0006E BNEQ 3 
61 8D 8F 90 0007 MOVB #-115, (RHB) + 0384 
FO AG 60 81 0007 S$ CMPW 3s (RO) , --16(R4) : 0389 
17 1F 00078 BLSSU : 
FO AG 55 81 007A CMPW LINE_FLAG, -16(R4) + 0391 
05 1F 0007E BLSSU ; 
0c EC AG 93 €1 00080 BBC #3, -20(R4), 7$ : 0392 
F4 B4 00010101 8F C8 00085 6s: BISL2 #65793, a-12(R4) : 0396 
EC AG 08 8A 00080 BICB2 #8, -20(R4) : 0398 
F2 AG 60 BI 90091 7$: CMP (RO), -14(R4) ; 0405 
60 F2 AG Wi 00097 SUBW2 -14(R4), (RO) + 0407 
53 E8 AG 3¢ 00098 8$: MOVZWL -24(R4). R3 : 0413 00: 
2B 15 0009F BLEQ 10$ : 
52 $0 3 S004 MOVZWL (RO), ADV_LINES > 0419 
52 5 2 C3 000A4 SUBL3 ADV_LINES? R3, ADV_LINES : 
‘ 1 OO0A8 BEQL 108 : 0420 
60 8 0 AA MOVW 3, (RO) + 0424 
32 D5 OOOAD TSTL  ADV_LINES > 0425 
17 18 OOOAF BGEQ ; 
01 «Al F2 AG 5 81 0081 ADDBS ADY LINES, -14(R4), 1(RHB) 0431 
OE EC AG ; EO nee BBS ¥ 58 (R4), 10$ : O38 
F4  B4 00010101 BF cA OBE BICL2 #6979 » a-12(R4) ; 9435 
01 Al 8% 9 O68 9$: MOVB  ADV_LINES, 1(RHB) : res 
E4 A& BS OOOCC 10$ TSTW seBtRa) + 0449 
09 13 OOOCF BEQL §-'11$ : 
60 E4 A& Ad 00001 ADDW “3 (R4), (RO) + 0455 
01 «Al E4 A& 80 00005 ADDB2 -28(R4). 1(RHB) : 0457 
FO AG 6 Bt ODA 11$:  CMPW (RO), -16(R4) > 0464 
1 4 ODE BLEQU§ 12$ : 
FO AG 35 f 9 EO cPY tell -16(R4) ; 0465 
F4 B84 00010101 F ch Miz: BISL2 #65793, a-12(R4) : 0467 


; Routine Size: 
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3$ 

BO). -16(R4) 

JNE_FLAG, -16(R4) 

8, -20(R4) 

RO), =14(R4) 

4$ 

14(R4), (RO) 

"Tei R ° 18 
18 

T 


E 
#17694730, RESP _D 
RESP_BUF , RESP_BE 


womes 


1 
PROMPT_DESC 

RESP DESC 

4+ CIBSGET_COMMAND 
RO, GET STATU 
GET_STATUS, 16$ 
RESP_DESC 

RESP~DESC 

#2, STRSUPCASE 

#3, RESP_BUF, CON 
#3, RESP_BUF, RET 
16$ 


15$ 
RET_STATUS, RO 


R4 
#1, SYSS$PUT 


mu & 


WAAAAAINITIND 
MEW —O0O~ 


~O~000000 


PUPPY IV SVSV SUIS VSS SVSUS ISIS SISOS 
erate eal ot oP ot rt ot a ot et ot 
o o 
OGOCOCooooowowoowowono 
AE WN (SO CONAOUS WN OOon 


WN" OVONAOULS WN “OOO NOULSWN—O0OMONS 


AOooouv 


DVDVPVPVPV PVPS AISI SII ITI 


output to RPG ree files 
M_PRINT = Finish logical page 


R 

ca 
ZSBTTL 'RPGSTERM PRINT = Fini 
GLOBAL ROUTINE RPSSTERA_BRint 


144 
A 


FUNCTIONAL DESCRIPTION: 


CALLING SEQUENCE: 
return_status.wlc.v = 

! FORMAL PARAMETERS: 

rab 


IMPLICIT INPUTS: 
RPGSW_CTX_FL 


RPGSW_CTX_LINE 
IMPLICIT OUTPUTS: 


ROUTINE VALUE: 


SIDE EFFECTS: 
NONE 


This routine is called to advance the number of Lin 
finish out the logical page before the actual CLOSE is done. 


AX-11 Bliss-32 iat ass 
RPGRTL.SRCIRPGPRINT -B3 31 


N 3 
Essai WedtsSt ra 


sh logical page’ 


REF SRAB_DECL ! RAB of file to be printed 


es needed to 


RPGSTERM_PRINT (rab.rr.r) 


address of the RAB of the file to be 
printed. 


specifies the number of Lines in the page body; 
-@., it specifies the number of Lines on the 
logical page that can be written. 


specifies the Line number at which the device is 
positioned within the current page body. 


A PUT to the Linage file is performed 


RMS status returned by the PUT operation or SS$_NORMAL if 
nothing needs to be done by this routine. 


Be Se Se Oe Se Se Ge ee Be Be Se Se Se Se Ge Se Fe Ge Ge Fe Se Fe Se Ge Se Se Fe ee Se Se Fe Se Se Se Se Se ee ee Se FO Se ese te Se ee Fe Se Se Se Se Seas 


DPV PVPS IV SV SV SVS SVS SVS SVSVSVSTSVSIS IS 
SSCS SF SSS see ee de-s 


AAPAAAAA AAA OA OO 
POPOPOPONON 2 os 


74 
75 


7? 


RPGSPRINT 
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Support output to RPG PRINTER files 1b-se -1984 02:18:04 AX-11 Bliss-32 V 
RPESTERM PRINT - Finish oataal page 12280 8=18e eer RPGRTL .SRC IRPGPR 
0633 BEGIN 
0634 
0635 LITERAL 
06 $ SET_ON = 1; 
06 
0638 LOCAL 
B73 RHB : REF BLOCK C,BYTE); ! Record header block 
0641 BIND 
pO46 FCB = RAB : REF BLOCK C,BYTE]; ! File context block 
0644 ' 
0645 ; :  RPGSTERM_PRINT should not cause access violations. Since it WILL 
0646 ' be called before the associated SYS$CLOSE, the RAB may be invalid. 
eat 2 Validate the RAB by checking that RABSW_ISI is non-zero. 
0649 : IF .RABCRAB$W_ISIJ EQL 0 
0650 § THEN 
0651 RETURN RPG$_EXTINDOFF; 
bees 2 
0653 2 ! , 
0654 2 : If no WRITE has ever been done for this file, then no adjustment 
0655 § ! meed be done at CLOSE time. Note that the flag bit is ¢ ecked_ 
bees § but not cleared; if it is set, we will not be doing a WRITE either. 
0658 2 IF .FCBCRPGS$SV_CTX_FIRST] EQL SET_ON 
0659 2 THEN 
0660 2 RETURN SS$_NORMAL; 
0661 2 
0662 2 ! f 3 
Beez $ Figure out how many Lines left to fill out the page 
0665 2 RHB = .RABCRAB$L_RHBI; 
poe RHBCPREFIX] = .FCBCRPGSW_CTX_FL] - .FCBCRPG$W_CTX_LINE] + 1; 
0668 ‘ 4 
0669 ; Make sure that there is something to advance. 

2 

; 

2 

2 

2 

2 

2 

2 

2 

1 


if .RHBCPREFIX) EQL 0 
RETURN SS$_NORMAL; 


advance in the PRN control fields. 


RABCRABSW_RSZ) = 
RHBLPOSTFIX] = 0; 


RETURN $PUT(RAB = .RAB); 
END; 


' 
: The actual WRITE is done by PUTing a record of 0 length with appropriate 
i 


0; 


RPGSPRINT Support output to RPG PRINTER files 
1-003 PGSTERM_PRINT = Finish logical page 
000C¢ 
50 6% AC OD 
2 AO ; 
oe 
50 90000000G 8F ? 
15 C AO €8 
52 C AO DO 
51 F2 AO 3C 
53 EE a0 C 
51 5 c 
62 51 01 81 
04 12 
50 01 dO 0 
04 0 
22 AO B40 
01 A2 940 
50 DD 0 
00000000G 00 01 FB QO 
04 0 
; Routine Size: 64 bytes, Routine Base: _RPGSCODE + 01C7 
626 0685 1 
627 0686 0 END ELUDGM 
PSECT SUMMARY 
Name Bytes 
_RPGSCODE 519 NOVEC,NOWRT, RD, 
Library Statistics 
coeccee= Symbols 
File Total Loaded 
-$255$DUA28: CSYSLIBISTARLET.L32;1 9776 16 
~$255$DUA28: CRPGRTL .OBJIRPG GLI iB. L32;% 54 12 


COMMAND QUALIFIERS 


4 
16- Sep-1984 18:04 AX-11 Bliss-32 V4.0-74 
1 a 1 yee RPGRTL.SRCJRPGPRINT.B32;1 
p08 ape RPGSTERM_PRINT, Save R2,R3 
00 RAB, RO ~ 
0006 TST e(R RO 
Bae BNEQ 
3 ? peyt snPGS -EXTINDOFF, RO 
it 1$ BLBS -20(R0), 2$ 
001 MOVL (RO), RHB 
0018 MOVZWL =14(ROS, R1 
OO1F MOVZWL <-18(RO), R3 
0023 SUBL R3, R1 
88 6 ADDB #1, R1, (RHB) 
O2A BNEQ 3$ 
O002C 2$: MOVL #1, RO 
002F RET 
00 9 3$: CLRW 34(RO) 
003 CLRB 1(RHB) 
0036 PUSHL RO 
0038 CALLS #1, SYSS$PUT 
003F RET 
Attributes 
EXE, SHR, LCL, REL, CON, PIC,ALIGN(2) 
wecceece Pages Processing 
Percent Mapped Time 
0 581 00:01. 9 
22 9 00:00.1 
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dD 4 
RPGSPRINT Support output to RPG PRINTER files 16-Sep-1984 02:18:04 AX-11 Bliss-32 V4.0-74 Pa 
ese RPESTERM. PRINT = ee sh logical page 18-3887 1382 9g: 48:98 ERPGRTL SRE RPGPRINT.B32;1 - 
b4 BLISS/CHECK=(FIELD, INITIAL,OPTIMIZE) /NOTRACE/LIS=LIS$:RPGPRINT/OBJ=OBJ$:RPGPRINT MSRC$:RPGPRINT/UPDATE=(ENH$:RPGPRINT) 
Size: 443 ogg + 76 data bytes 
Run Time: 215.7 


; Elapsed Time: 746.1 
3; Lines/CPU Min: 000 
3 Lexemes/CPU-Min: 21161 
; — Used: 189 pages 
; Compilation Complete 


SE EQUIPMENT CORPORATION 
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